library(ggplot2)
library(tidyverse)
diamonds<-read_csv("diamonds4.csv")

── Column specification ─────────────────────────────────────────────────────────────────────────
cols(
  carat = col_double(),
  clarity = col_character(),
  color = col_character(),
  cut = col_character(),
  price = col_double()
)
#Check Data Loaded Properly:
head(diamonds)
NA
NA

Get size/shape of Data:

nrow(diamonds)
[1] 1214
ncol(diamonds)
[1] 5
dim(diamonds)
[1] 1214    5

5 variables, and 1,214 rows

Checking for NA’s:

(diamonds[!complete.cases(diamonds),])
(diamonds[complete.cases(diamonds),])

No Na’s in data-nice.

Check for levels:

levels(diamonds$cut)
NULL
levels(diamonds$color)
NULL
levels(diamonds$clarity)
NULL

No levels. We’ll need to add some factors to get data in order that matches the website, since alphabetical won’t work for all data:

diamonds<- diamonds%>%
  mutate(cut = cut%>%
           fct_relevel(c("Good","Very Good","Ideal","Astor Ideal")))

diamonds<- diamonds%>%
  mutate(clarity = clarity%>%
           fct_relevel(c("SI2","SI1","VS2","VS1", "VVS2", "VVS1", "IF", "FL")))

#Since R defaults to alphabetical order, we don't need to neccessarily add factors here, but doing so to flip order the same as above

diamonds<- diamonds%>%
  mutate(color = color%>%
           fct_relevel(c("J","I","H","G", "F", "E", "D")))

#Check new levels:

levels(diamonds$cut)
[1] "Good"        "Very Good"   "Ideal"       "Astor Ideal"
levels(diamonds$color)
[1] "J" "I" "H" "G" "F" "E" "D"
levels(diamonds$clarity)
[1] "SI2"  "SI1"  "VS2"  "VS1"  "VVS2" "VVS1" "IF"   "FL"  

To visual distributions of different parameters:

ggplot(diamonds, aes(x=cut))+
  geom_bar(fill="blue")+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Distribution of Diamonds by Cut")


ggplot(diamonds, aes(x=clarity))+
  geom_bar(fill="red")+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Distribution of Diamonds by Clarity")


ggplot(diamonds, aes(x=color))+
  geom_bar(fill="green")+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Distribution of Diamonds by Color")

Scatter plot of Price vs Carat:

ggplot(data = diamonds, aes(x = carat, y = price)) +
  geom_point()+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Scatterplot of Carat against Price", 
       x = "Carat",
         y = "Price")

Scatter plot of Price vs Carat with all parameters added:

ggplot(data = diamonds, aes(x = carat, y = price, color = color, size = clarity, shape = cut)) +
  geom_point()+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Scatterplot of Price Against Carat With Other Variables", 
       x = "Carat",
       y = "Price (USD)")
Warning: Using size for a discrete variable is not advised.

Very Messy and not particularly useful, so let’s break it down into indvidual variables:


ggplot(data = diamonds, aes(x = carat, y = price, color = clarity))+
  geom_point()+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Scatterplot of Price Against Carat With Clarity", 
       x = "Carat",
       y = "Price (USD)")

  
  
ggplot(data = diamonds, aes(x = carat, y = price, color = color)) +
  geom_point()+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Scatterplot of Price Against Carat With Color", 
       x = "Carat",
       y = "Price (USD)")

  
  
ggplot(data = diamonds, aes(x = carat, y = price, color = cut)) +
  geom_point()+ 
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Scatterplot of Price Against Carat With Cut", 
                     x = "Carat",
                     y = "Price (USD)")

Website Claims order of importance is: Cut, color, carat, clarity

First: create new column “price/carat” to control for carat size as we explore how other attributes affect price

diamonds<-diamonds%>%
  mutate(PricePerCarat = price/carat)

Get grouped means of price per carat for each attribute:

ClarityVSPricePerCarat<-diamonds%>%
  group_by(clarity)%>%
  summarize(meanPrice=mean(PricePerCarat))

ColorVSPricePerCarat<-diamonds%>%
  group_by(color)%>%
  summarize(meanPrice=mean(PricePerCarat))

CutVSPricePerCarat<-diamonds%>%
  group_by(cut)%>%
  summarize(meanPrice=mean(PricePerCarat))

Plots of grouped Means:

ggplot(ClarityVSPricePerCarat, aes(x=clarity, y=meanPrice))+
  geom_bar(stat="identity", fill = "red")+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Mean Price per Carat by Clarity", 
       x = "Clarity",
       y = "Mean Price Per Carat")


ggplot(ColorVSPricePerCarat, aes(x=color, y=meanPrice))+
  geom_bar(stat="identity", fill = "blue")+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Mean Price per Carat by Color", 
       x = "Color",
       y = "Mean Price Per Carat")


ggplot(CutVSPricePerCarat, aes(x=cut, y=meanPrice))+
  geom_bar(stat="identity", fill = "green")+
  theme(plot.title = element_text(hjust = .5))+
  labs(title = "Mean Price per Carat by Cut",
       x = "Cut",
       y = "Mean Price Per Carat")

#looking at some outliers

diamonds%>%
  filter(clarity == "FL")

diamonds%>%
  filter(cut == "Ideal")

diamonds%>%
  filter(color == "H")
ggplot(diamonds, aes(x=cut,fill=color))+
  geom_bar(position='fill')+
  theme(axis.text.x = element_text(),
        plot.title = element_text(hjust = 0.5))+
  labs(title="Distribution of cut vs color")

#Other than Astor Ideal (which only has 20 datapoints), good color seems to decrease as cut gets better. This corrlation could be a factor in why cut does not seem to correlate as much with price/carat.

Regression Code

library(MASS) 
library(tidyverse)
dimonds <- read.csv("diamonds4.csv")
dimonds
ggplot(data = dimonds, mapping = aes(x=carat, y = price))+
  geom_point()+
  labs(x="Carat", y="Price", title="General Scatter Plot of Price vs Carrat")

ggplot(data = dimonds, mapping = aes(x=carat, y = price))+
  geom_point()+
  geom_smooth(method = "lm", se=FALSE)+ 
  labs(x="Carat", y="Price", title="General Scatter Plot of Price vs Carrat (With Regression Line)")
`geom_smooth()` using formula 'y ~ x'

Data = dimonds
result<-lm(price~carat, data=Data)
yhat<-result$fitted.values
res<-result$residuals
Data<-data.frame(Data,yhat,res)

## adding inital attributes to the Data DF
ggplot(Data, aes(x=yhat,y=res))+
  geom_point()+
  geom_hline(yintercept=0, color="red")+
  labs(x="Fitted y", y="Residuals", title="Inital Residual Plot (No Transformations)")

boxcox(result, lambda = seq(0,.5,1/10), main= "Box Cox (No Transformations")
Warning: In lm.fit(x, y, offset = offset, singular.ok = singular.ok, ...) :
 extra argument ‘main’ will be disregarded

### First transformation:


##transform y and then regress ystar on x
ystar<-log(Data$price)
Data<-data.frame(Data,ystar)
result.ystar<-lm(ystar~carat, data=Data)

##store fitted y & residuals
yhat2<-result.ystar$fitted.values
res2<-result.ystar$residuals

##add to data frame
Data<-data.frame(Data,yhat2,res2)

##residual plot with ystar
ggplot(Data, aes(x=yhat2,y=res2))+
  geom_point()+
  geom_hline(yintercept=0, color="red")+
  labs(x="Fitted y", y="Residuals", title="Residual Plot with ystar")


boxcox(result.ystar, lambda = seq(2,4,1/10))

## acf plot
# par(mar=c(5,5,5,0))
# acf(res2, main="ACF Plot of Residuals with ystar")
# ## QQ plot
# qqnorm(res2)
# qqline(res2, col="red")


result.ystar

Call:
lm(formula = ystar ~ carat, data = Data)

Coefficients:
(Intercept)        carat  
      6.432        1.457  
### Second transformation:


##transform y and then regress ystar on x
xstar<-log(Data$carat)
Data<-data.frame(Data,xstar)
result.xstar<-lm(ystar~xstar, data=Data)

##store fitted y & residuals
yhat3<-result.xstar$fitted.values
res3<-result.xstar$residuals

##add to data frame
Data<-data.frame(Data,yhat3,res3)

##residual plot with ystar
ggplot(Data, aes(x=yhat3,y=res3))+
  geom_point()+
  geom_hline(yintercept=0, color="red")+
  labs(x="Fitted y", y="Residuals", title="Residual Plot with ystar")


boxcox(result.xstar)
## acf plot
par(mar=c(5,5,5,0))

acf(res3, main="ACF Plot of Residuals with ystar and xstar",lag.max = 15)

## QQ plot
qqnorm(res3)
qqline(res3, col="red")


result.xstar

Call:
lm(formula = ystar ~ xstar, data = Data)

Coefficients:
(Intercept)        xstar  
      8.521        1.944  
ggplot(data=Data, mapping = aes(x=xstar, y=ystar))+
  geom_point()+
  geom_smooth(method = "lm", se=FALSE)+
  labs(title="Final Regression with xstar and ystar")
`geom_smooth()` using formula 'y ~ x'

NA
result.xstar

Call:
lm(formula = ystar ~ xstar, data = Data)

Coefficients:
(Intercept)        xstar  
      8.521        1.944  

log(y) = 8.521 + 1.944 log(x)

LS0tCnRpdGxlOiAiQ29uc29saWRhdGVkX01hcmtkb3duIG9mIGNvZGUiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCgoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkKYGBgCgoKYGBge3J9CmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeSh0aWR5dmVyc2UpCmRpYW1vbmRzPC1yZWFkX2NzdigiZGlhbW9uZHM0LmNzdiIpCgojQ2hlY2sgRGF0YSBMb2FkZWQgUHJvcGVybHk6CmhlYWQoZGlhbW9uZHMpCgoKYGBgCgpHZXQgc2l6ZS9zaGFwZSBvZiBEYXRhOgoKYGBge3J9Cm5yb3coZGlhbW9uZHMpCm5jb2woZGlhbW9uZHMpCmRpbShkaWFtb25kcykKCmBgYAoKNSB2YXJpYWJsZXMsIGFuZCAxLDIxNCByb3dzCgpDaGVja2luZyBmb3IgTkEnczoKCmBgYHtyfQooZGlhbW9uZHNbIWNvbXBsZXRlLmNhc2VzKGRpYW1vbmRzKSxdKQooZGlhbW9uZHNbY29tcGxldGUuY2FzZXMoZGlhbW9uZHMpLF0pCmBgYAoKCk5vIE5hJ3MgaW4gZGF0YS1uaWNlLiAKCkNoZWNrIGZvciBsZXZlbHM6CgpgYGB7cn0KbGV2ZWxzKGRpYW1vbmRzJGN1dCkKbGV2ZWxzKGRpYW1vbmRzJGNvbG9yKQpsZXZlbHMoZGlhbW9uZHMkY2xhcml0eSkKYGBgCgoKTm8gbGV2ZWxzLiBXZSdsbCBuZWVkIHRvIGFkZCBzb21lIGZhY3RvcnMgdG8gZ2V0IGRhdGEgaW4gb3JkZXIgdGhhdCBtYXRjaGVzIHRoZQp3ZWJzaXRlLCBzaW5jZSBhbHBoYWJldGljYWwgd29uJ3Qgd29yayBmb3IgYWxsIGRhdGE6CgpgYGB7cn0KZGlhbW9uZHM8LSBkaWFtb25kcyU+JQogIG11dGF0ZShjdXQgPSBjdXQlPiUKICAgICAgICAgICBmY3RfcmVsZXZlbChjKCJHb29kIiwiVmVyeSBHb29kIiwiSWRlYWwiLCJBc3RvciBJZGVhbCIpKSkKCmRpYW1vbmRzPC0gZGlhbW9uZHMlPiUKICBtdXRhdGUoY2xhcml0eSA9IGNsYXJpdHklPiUKICAgICAgICAgICBmY3RfcmVsZXZlbChjKCJTSTIiLCJTSTEiLCJWUzIiLCJWUzEiLCAiVlZTMiIsICJWVlMxIiwgIklGIiwgIkZMIikpKQoKI1NpbmNlIFIgZGVmYXVsdHMgdG8gYWxwaGFiZXRpY2FsIG9yZGVyLCB3ZSBkb24ndCBuZWVkIHRvIG5lY2Nlc3NhcmlseSBhZGQgZmFjdG9ycyBoZXJlLCBidXQgZG9pbmcgc28gdG8gZmxpcCBvcmRlciB0aGUgc2FtZSBhcyBhYm92ZQoKZGlhbW9uZHM8LSBkaWFtb25kcyU+JQogIG11dGF0ZShjb2xvciA9IGNvbG9yJT4lCiAgICAgICAgICAgZmN0X3JlbGV2ZWwoYygiSiIsIkkiLCJIIiwiRyIsICJGIiwgIkUiLCAiRCIpKSkKCiNDaGVjayBuZXcgbGV2ZWxzOgoKbGV2ZWxzKGRpYW1vbmRzJGN1dCkKbGV2ZWxzKGRpYW1vbmRzJGNvbG9yKQpsZXZlbHMoZGlhbW9uZHMkY2xhcml0eSkKCmBgYAoKCgpUbyB2aXN1YWwgZGlzdHJpYnV0aW9ucyBvZiBkaWZmZXJlbnQgcGFyYW1ldGVyczoKCgpgYGB7cn0KZ2dwbG90KGRpYW1vbmRzLCBhZXMoeD1jdXQpKSsKICBnZW9tX2JhcihmaWxsPSJibHVlIikrCiAgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IC41KSkrCiAgbGFicyh0aXRsZSA9ICJEaXN0cmlidXRpb24gb2YgRGlhbW9uZHMgYnkgQ3V0IikKCmdncGxvdChkaWFtb25kcywgYWVzKHg9Y2xhcml0eSkpKwogIGdlb21fYmFyKGZpbGw9InJlZCIpKwogIHRoZW1lKHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAuNSkpKwogIGxhYnModGl0bGUgPSAiRGlzdHJpYnV0aW9uIG9mIERpYW1vbmRzIGJ5IENsYXJpdHkiKQoKZ2dwbG90KGRpYW1vbmRzLCBhZXMoeD1jb2xvcikpKwogIGdlb21fYmFyKGZpbGw9ImdyZWVuIikrCiAgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IC41KSkrCiAgbGFicyh0aXRsZSA9ICJEaXN0cmlidXRpb24gb2YgRGlhbW9uZHMgYnkgQ29sb3IiKQoKYGBgCgoKClNjYXR0ZXIgcGxvdCBvZiBQcmljZSB2cyBDYXJhdDoKCmBgYHtyfQpnZ3Bsb3QoZGF0YSA9IGRpYW1vbmRzLCBhZXMoeCA9IGNhcmF0LCB5ID0gcHJpY2UpKSArCiAgZ2VvbV9wb2ludCgpKwogIHRoZW1lKHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAuNSkpKwogIGxhYnModGl0bGUgPSAiU2NhdHRlcnBsb3Qgb2YgQ2FyYXQgYWdhaW5zdCBQcmljZSIsIAogICAgICAgeCA9ICJDYXJhdCIsCiAgICAgICAgIHkgPSAiUHJpY2UiKQoKYGBgCgogICAgICAgICAKU2NhdHRlciBwbG90IG9mIFByaWNlIHZzIENhcmF0IHdpdGggYWxsIHBhcmFtZXRlcnMgYWRkZWQ6CiAgICAgICAgIAoKYGBge3J9CmdncGxvdChkYXRhID0gZGlhbW9uZHMsIGFlcyh4ID0gY2FyYXQsIHkgPSBwcmljZSwgY29sb3IgPSBjb2xvciwgc2l6ZSA9IGNsYXJpdHksIHNoYXBlID0gY3V0KSkgKwogIGdlb21fcG9pbnQoKSsKICB0aGVtZShwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gLjUpKSsKICBsYWJzKHRpdGxlID0gIlNjYXR0ZXJwbG90IG9mIFByaWNlIEFnYWluc3QgQ2FyYXQgV2l0aCBPdGhlciBWYXJpYWJsZXMiLCAKICAgICAgIHggPSAiQ2FyYXQiLAogICAgICAgeSA9ICJQcmljZSAoVVNEKSIpCmBgYAoKClZlcnkgTWVzc3kgYW5kIG5vdCBwYXJ0aWN1bGFybHkgdXNlZnVsLCBzbyBsZXQncyBicmVhayBpdCBkb3duIGludG8gaW5kdmlkdWFsIHZhcmlhYmxlczoKYGBge3J9CgpnZ3Bsb3QoZGF0YSA9IGRpYW1vbmRzLCBhZXMoeCA9IGNhcmF0LCB5ID0gcHJpY2UsIGNvbG9yID0gY2xhcml0eSkpKwogIGdlb21fcG9pbnQoKSsKICB0aGVtZShwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gLjUpKSsKICBsYWJzKHRpdGxlID0gIlNjYXR0ZXJwbG90IG9mIFByaWNlIEFnYWluc3QgQ2FyYXQgV2l0aCBDbGFyaXR5IiwgCiAgICAgICB4ID0gIkNhcmF0IiwKICAgICAgIHkgPSAiUHJpY2UgKFVTRCkiKQogIAogIApnZ3Bsb3QoZGF0YSA9IGRpYW1vbmRzLCBhZXMoeCA9IGNhcmF0LCB5ID0gcHJpY2UsIGNvbG9yID0gY29sb3IpKSArCiAgZ2VvbV9wb2ludCgpKwogIHRoZW1lKHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAuNSkpKwogIGxhYnModGl0bGUgPSAiU2NhdHRlcnBsb3Qgb2YgUHJpY2UgQWdhaW5zdCBDYXJhdCBXaXRoIENvbG9yIiwgCiAgICAgICB4ID0gIkNhcmF0IiwKICAgICAgIHkgPSAiUHJpY2UgKFVTRCkiKQogIAogIApnZ3Bsb3QoZGF0YSA9IGRpYW1vbmRzLCBhZXMoeCA9IGNhcmF0LCB5ID0gcHJpY2UsIGNvbG9yID0gY3V0KSkgKwogIGdlb21fcG9pbnQoKSsgCiAgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IC41KSkrCiAgbGFicyh0aXRsZSA9ICJTY2F0dGVycGxvdCBvZiBQcmljZSBBZ2FpbnN0IENhcmF0IFdpdGggQ3V0IiwgCiAgICAgICAgICAgICAgICAgICAgIHggPSAiQ2FyYXQiLAogICAgICAgICAgICAgICAgICAgICB5ID0gIlByaWNlIChVU0QpIikKYGBgCgpXZWJzaXRlIENsYWltcyBvcmRlciBvZiBpbXBvcnRhbmNlIGlzOiBDdXQsIGNvbG9yLCBjYXJhdCwgY2xhcml0eQoKCkZpcnN0OiBjcmVhdGUgbmV3IGNvbHVtbiAicHJpY2UvY2FyYXQiIHRvIGNvbnRyb2wgZm9yIGNhcmF0IHNpemUgYXMgd2UgZXhwbG9yZSBob3cgb3RoZXIgYXR0cmlidXRlcyBhZmZlY3QgcHJpY2UKCgpgYGB7cn0KZGlhbW9uZHM8LWRpYW1vbmRzJT4lCiAgbXV0YXRlKFByaWNlUGVyQ2FyYXQgPSBwcmljZS9jYXJhdCkKYGBgCgoKCkdldCBncm91cGVkIG1lYW5zIG9mIHByaWNlIHBlciBjYXJhdCBmb3IgZWFjaCBhdHRyaWJ1dGU6CgpgYGB7cn0KQ2xhcml0eVZTUHJpY2VQZXJDYXJhdDwtZGlhbW9uZHMlPiUKICBncm91cF9ieShjbGFyaXR5KSU+JQogIHN1bW1hcml6ZShtZWFuUHJpY2U9bWVhbihQcmljZVBlckNhcmF0KSkKCkNvbG9yVlNQcmljZVBlckNhcmF0PC1kaWFtb25kcyU+JQogIGdyb3VwX2J5KGNvbG9yKSU+JQogIHN1bW1hcml6ZShtZWFuUHJpY2U9bWVhbihQcmljZVBlckNhcmF0KSkKCkN1dFZTUHJpY2VQZXJDYXJhdDwtZGlhbW9uZHMlPiUKICBncm91cF9ieShjdXQpJT4lCiAgc3VtbWFyaXplKG1lYW5QcmljZT1tZWFuKFByaWNlUGVyQ2FyYXQpKQpgYGAKCgpQbG90cyBvZiBncm91cGVkIE1lYW5zOgoKYGBge3J9CmdncGxvdChDbGFyaXR5VlNQcmljZVBlckNhcmF0LCBhZXMoeD1jbGFyaXR5LCB5PW1lYW5QcmljZSkpKwogIGdlb21fYmFyKHN0YXQ9ImlkZW50aXR5IiwgZmlsbCA9ICJyZWQiKSsKICB0aGVtZShwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gLjUpKSsKICBsYWJzKHRpdGxlID0gIk1lYW4gUHJpY2UgcGVyIENhcmF0IGJ5IENsYXJpdHkiLCAKICAgICAgIHggPSAiQ2xhcml0eSIsCiAgICAgICB5ID0gIk1lYW4gUHJpY2UgUGVyIENhcmF0IikKCmdncGxvdChDb2xvclZTUHJpY2VQZXJDYXJhdCwgYWVzKHg9Y29sb3IsIHk9bWVhblByaWNlKSkrCiAgZ2VvbV9iYXIoc3RhdD0iaWRlbnRpdHkiLCBmaWxsID0gImJsdWUiKSsKICB0aGVtZShwbG90LnRpdGxlID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gLjUpKSsKICBsYWJzKHRpdGxlID0gIk1lYW4gUHJpY2UgcGVyIENhcmF0IGJ5IENvbG9yIiwgCiAgICAgICB4ID0gIkNvbG9yIiwKICAgICAgIHkgPSAiTWVhbiBQcmljZSBQZXIgQ2FyYXQiKQoKZ2dwbG90KEN1dFZTUHJpY2VQZXJDYXJhdCwgYWVzKHg9Y3V0LCB5PW1lYW5QcmljZSkpKwogIGdlb21fYmFyKHN0YXQ9ImlkZW50aXR5IiwgZmlsbCA9ICJncmVlbiIpKwogIHRoZW1lKHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoaGp1c3QgPSAuNSkpKwogIGxhYnModGl0bGUgPSAiTWVhbiBQcmljZSBwZXIgQ2FyYXQgYnkgQ3V0IiwKICAgICAgIHggPSAiQ3V0IiwKICAgICAgIHkgPSAiTWVhbiBQcmljZSBQZXIgQ2FyYXQiKQoKYGBgCgoKCiNsb29raW5nIGF0IHNvbWUgb3V0bGllcnMKYGBge3J9CmRpYW1vbmRzJT4lCiAgZmlsdGVyKGNsYXJpdHkgPT0gIkZMIikKCmRpYW1vbmRzJT4lCiAgZmlsdGVyKGN1dCA9PSAiSWRlYWwiKQoKZGlhbW9uZHMlPiUKICBmaWx0ZXIoY29sb3IgPT0gIkgiKQpgYGAKCgoKYGBge3J9CmdncGxvdChkaWFtb25kcywgYWVzKHg9Y3V0LGZpbGw9Y29sb3IpKSsKICBnZW9tX2Jhcihwb3NpdGlvbj0nZmlsbCcpKwogIHRoZW1lKGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KCksCiAgICAgICAgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDAuNSkpKwogIGxhYnModGl0bGU9IkRpc3RyaWJ1dGlvbiBvZiBjdXQgdnMgY29sb3IiKQpgYGAKI090aGVyIHRoYW4gQXN0b3IgSWRlYWwgKHdoaWNoIG9ubHkgaGFzIDIwIGRhdGFwb2ludHMpLCBnb29kIGNvbG9yIHNlZW1zIHRvIGRlY3JlYXNlIGFzIGN1dCBnZXRzIGJldHRlci4gVGhpcyBjb3JybGF0aW9uIGNvdWxkIGJlIGEgZmFjdG9yIGluIHdoeSBjdXQgZG9lcyBub3Qgc2VlbSB0byBjb3JyZWxhdGUgYXMgbXVjaCB3aXRoIHByaWNlL2NhcmF0LgoKCgoKCgojIFJlZ3Jlc3Npb24gQ29kZQoKCgoKCgoKCmBgYHtyfQpsaWJyYXJ5KE1BU1MpIApsaWJyYXJ5KHRpZHl2ZXJzZSkKYGBgCgpgYGB7cn0KZGltb25kcyA8LSByZWFkLmNzdigiZGlhbW9uZHM0LmNzdiIpCmRpbW9uZHMKYGBgCmBgYHtyfQpnZ3Bsb3QoZGF0YSA9IGRpbW9uZHMsIG1hcHBpbmcgPSBhZXMoeD1jYXJhdCwgeSA9IHByaWNlKSkrCiAgZ2VvbV9wb2ludCgpKwogIGxhYnMoeD0iQ2FyYXQiLCB5PSJQcmljZSIsIHRpdGxlPSJHZW5lcmFsIFNjYXR0ZXIgUGxvdCBvZiBQcmljZSB2cyBDYXJyYXQiKQpgYGAKCgpgYGB7cn0KZ2dwbG90KGRhdGEgPSBkaW1vbmRzLCBtYXBwaW5nID0gYWVzKHg9Y2FyYXQsIHkgPSBwcmljZSkpKwogIGdlb21fcG9pbnQoKSsKICBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCBzZT1GQUxTRSkrIAogIGxhYnMoeD0iQ2FyYXQiLCB5PSJQcmljZSIsIHRpdGxlPSJHZW5lcmFsIFNjYXR0ZXIgUGxvdCBvZiBQcmljZSB2cyBDYXJyYXQgKFdpdGggUmVncmVzc2lvbiBMaW5lKSIpCmBgYAoKCmBgYHtyfQpEYXRhID0gZGltb25kcwpyZXN1bHQ8LWxtKHByaWNlfmNhcmF0LCBkYXRhPURhdGEpCnloYXQ8LXJlc3VsdCRmaXR0ZWQudmFsdWVzCnJlczwtcmVzdWx0JHJlc2lkdWFscwpEYXRhPC1kYXRhLmZyYW1lKERhdGEseWhhdCxyZXMpCgojIyBhZGRpbmcgaW5pdGFsIGF0dHJpYnV0ZXMgdG8gdGhlIERhdGEgREYKYGBgCgoKCmBgYHtyfQpnZ3Bsb3QoRGF0YSwgYWVzKHg9eWhhdCx5PXJlcykpKwogIGdlb21fcG9pbnQoKSsKICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQ9MCwgY29sb3I9InJlZCIpKwogIGxhYnMoeD0iRml0dGVkIHkiLCB5PSJSZXNpZHVhbHMiLCB0aXRsZT0iSW5pdGFsIFJlc2lkdWFsIFBsb3QgKE5vIFRyYW5zZm9ybWF0aW9ucykiKQpgYGAKCmBgYHtyfQpib3hjb3gocmVzdWx0LCBsYW1iZGEgPSBzZXEoMCwuNSwxLzEwKSwgbWFpbj0gIkJveCBDb3ggKE5vIFRyYW5zZm9ybWF0aW9ucyIpCmBgYAoKCmBgYHtyfQojIyMgRmlyc3QgdHJhbnNmb3JtYXRpb246CgoKIyN0cmFuc2Zvcm0geSBhbmQgdGhlbiByZWdyZXNzIHlzdGFyIG9uIHgKeXN0YXI8LWxvZyhEYXRhJHByaWNlKQpEYXRhPC1kYXRhLmZyYW1lKERhdGEseXN0YXIpCnJlc3VsdC55c3RhcjwtbG0oeXN0YXJ+Y2FyYXQsIGRhdGE9RGF0YSkKCiMjc3RvcmUgZml0dGVkIHkgJiByZXNpZHVhbHMKeWhhdDI8LXJlc3VsdC55c3RhciRmaXR0ZWQudmFsdWVzCnJlczI8LXJlc3VsdC55c3RhciRyZXNpZHVhbHMKCiMjYWRkIHRvIGRhdGEgZnJhbWUKRGF0YTwtZGF0YS5mcmFtZShEYXRhLHloYXQyLHJlczIpCgojI3Jlc2lkdWFsIHBsb3Qgd2l0aCB5c3RhcgpnZ3Bsb3QoRGF0YSwgYWVzKHg9eWhhdDIseT1yZXMyKSkrCiAgZ2VvbV9wb2ludCgpKwogIGdlb21faGxpbmUoeWludGVyY2VwdD0wLCBjb2xvcj0icmVkIikrCiAgbGFicyh4PSJGaXR0ZWQgeSIsIHk9IlJlc2lkdWFscyIsIHRpdGxlPSJSZXNpZHVhbCBQbG90IHdpdGggeXN0YXIiKQoKYm94Y294KHJlc3VsdC55c3RhciwgbGFtYmRhID0gc2VxKDIsNCwxLzEwKSkKIyMgYWNmIHBsb3QKIyBwYXIobWFyPWMoNSw1LDUsMCkpCiMgYWNmKHJlczIsIG1haW49IkFDRiBQbG90IG9mIFJlc2lkdWFscyB3aXRoIHlzdGFyIikKIyAjIyBRUSBwbG90CiMgcXFub3JtKHJlczIpCiMgcXFsaW5lKHJlczIsIGNvbD0icmVkIikKCgpyZXN1bHQueXN0YXIKYGBgCgpgYGB7cn0KIyMjIFNlY29uZCB0cmFuc2Zvcm1hdGlvbjoKCgojI3RyYW5zZm9ybSB5IGFuZCB0aGVuIHJlZ3Jlc3MgeXN0YXIgb24geAp4c3RhcjwtbG9nKERhdGEkY2FyYXQpCkRhdGE8LWRhdGEuZnJhbWUoRGF0YSx4c3RhcikKcmVzdWx0LnhzdGFyPC1sbSh5c3Rhcn54c3RhciwgZGF0YT1EYXRhKQoKIyNzdG9yZSBmaXR0ZWQgeSAmIHJlc2lkdWFscwp5aGF0MzwtcmVzdWx0LnhzdGFyJGZpdHRlZC52YWx1ZXMKcmVzMzwtcmVzdWx0LnhzdGFyJHJlc2lkdWFscwoKIyNhZGQgdG8gZGF0YSBmcmFtZQpEYXRhPC1kYXRhLmZyYW1lKERhdGEseWhhdDMscmVzMykKCiMjcmVzaWR1YWwgcGxvdCB3aXRoIHlzdGFyCmdncGxvdChEYXRhLCBhZXMoeD15aGF0Myx5PXJlczMpKSsKICBnZW9tX3BvaW50KCkrCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0PTAsIGNvbG9yPSJyZWQiKSsKICBsYWJzKHg9IkZpdHRlZCB5IiwgeT0iUmVzaWR1YWxzIiwgdGl0bGU9IlJlc2lkdWFsIFBsb3Qgd2l0aCB5c3RhciIpCgpib3hjb3gocmVzdWx0LnhzdGFyKQojIyBhY2YgcGxvdApwYXIobWFyPWMoNSw1LDUsMCkpCmFjZihyZXMzLCBtYWluPSJBQ0YgUGxvdCBvZiBSZXNpZHVhbHMgd2l0aCB5c3RhciBhbmQgeHN0YXIiLGxhZy5tYXggPSAxNSkKIyMgUVEgcGxvdApxcW5vcm0ocmVzMykKcXFsaW5lKHJlczMsIGNvbD0icmVkIikKCnJlc3VsdC54c3RhcgpgYGAKCgoKYGBge3J9CmdncGxvdChkYXRhPURhdGEsIG1hcHBpbmcgPSBhZXMoeD14c3RhciwgeT15c3RhcikpKwogIGdlb21fcG9pbnQoKSsKICBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCBzZT1GQUxTRSkrCiAgbGFicyh0aXRsZT0iRmluYWwgUmVncmVzc2lvbiB3aXRoIHhzdGFyIGFuZCB5c3RhciIpCiAgCmBgYAoKYGBge3J9CnJlc3VsdC54c3RhcgpgYGAKCmxvZyh5KSA9IDguNTIxICsgMS45NDQgbG9nKHgpCgojCg==